
(defmeth HOMALS-PROTO :visualize ()
  (if (not (eq current-object self)) (setcm self))
  (let* ((scores (send self :Z))
         (quantification  (send self :Y))
         (scores-and-quantification (bind-rows scores quantification))                            
         (ndim (send self :p))
         (nobs (send self :nobs))
         (ncat (length (combine (send self :category-labels))))
         (point-labels (send self :label-object-by))
         (nvar (send self :nvar))
         (n (mapcar #'length (send self :active-categories)));number of active categories
         (nobs-n (combine nobs n))
         (a (- (cumsum n) n))
         (a2 (- (cumsum nobs-n) nobs-n))
         (my-g (make-color 'my-g  0.4 0.7 0.4))
         (my-y (make-color 'my-y 0.90 0.90 0.30))
         (my-gr (make-color 'my-gr 0.50 0.50 0.50))
         (my-br (make-color 'my-b 0.85 0.6 0.4))
         (my-v (make-color 'my-v 0.75 0.2 0.75))
         (my-colors (list 'red 'my-g 'my-gr 'my-v 'my-y 'my-b 'black 'cyan 'magenta 'green))
         (c (select (repeat my-colors 3) (iseq nvar)))
         (var-labels (send self :variables)) 
         (score-cols (select (column-list scores) (iseq ndim)))
         (quantification-cols  (select (column-list quantification) (iseq ndim)))
         (scores-and-quantification-cols (select (column-list scores-and-quantification)          (iseq ndim)))
         (Dim-Labels (mapcar #'(lambda (x) (format nil "Dim~a  " x))(+ 1 (iseq ndim))))
         (category-labels (combine (send self :category-labels)))
         ;(point-labels (send self :object-labels))
         (variable-labels (send self :variables))
         (d-m-cols (transpose (mapcar 'diagonal (send self :d-m))))
         (obs-and-cat-labels (combine  point-labels (send self :category-labels)))


         (scatmat
            (if (> ndim 2)
              (scatterplot-matrix scores-and-quantification-cols 
                                  :point-labels obs-and-cat-labels
                                  :variable-labels dim-labels 
                                  :title "HOMALS Scatterplot-matrix"
                                  :show nil)      nil))
         (spin-plot 
           (if (> ndim 2)
               (spin-plot scores-and-quantification-cols 
                          :point-labels obs-and-cat-labels
                          :variable-labels dim-labels
                          :title "HOMALS Spinning Plot"
                          :showing-axes t
                          :show nil) nil))
          
         (scatterplot (plot-points scores-and-quantification-cols 
                               :point-labels obs-and-cat-labels 
                               :variable-labels dim-labels
                               :title "HOMALS Scatterplot"
                               :show nil))

         (obs-list (name-list obs-and-cat-labels :title "HOMALS-List" :show nil))
         (boxplot2 (BOXPLOT d-m-cols
                               :point-labels var-labels
                               :variable-labels dim-labels  
                               :connect-points 
                               :title "Discrimination Measures"
                               :show nil))

        
         (sp (if (> ndim 2)
                 (spread-plot 
                      (matrix '(2 3)
                          (list obs-list spin-plot scatmat nil nil 
                               boxplot2))
              :rel-widths (list .5 2 1)
               :span-down (matrix (list 2 3) (list 2 2 1  0 0 1)))
                 (spread-plot 
                      (matrix '(1 3)
                          (list obs-list scatterplot boxplot2)))))
       
                  )

(when (> ndim 2)
          (send scatmat :linked t)
          (send scatmat :add-mouse-mode 'focus-on-variables
                :title "Focus On Variables"
                :click :do-new-variable-focus
                :cursor 'finger)
          (send scatmat :mouse-mode 'focus-on-variables)
          (send scatmat :plot-buttons :new-x nil :new-y nil)
          (send scatmat :use-color t)
          (send scatmat :point-color (iseq (+ nobs ncat)) 'blue)
          (mapcar #'(lambda (a n c) (send scatmat :point-color (+ nobs(iseq a (+ a n))) c)) a n c)
          (if (> nobs 30) (send scatmat :point-symbol (iseq (+ nobs ncat)) 'dot) 
                    (send scatmat :point-symbol (iseq (+ nobs ncat)) 'disk))
    (send scatmat :point-symbol (+ nobs (iseq ncat)) 'square)
          (send scatmat :menu-template 
                '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH SYMBOL COLOR))
          (send scatmat :new-menu)
          (defmeth scatmat :update-plotcell (i j args)
            (when (and (= i 1) (= j 1))
                  (send self :point-state (iseq (send self :num-points))
                        (first args))))
          (defmeth scatmat :adjust-points-in-rect (&rest args)
            (apply #'call-next-method args)
            (send sp :update-spreadplot 
                  0 4 (send self :point-state (iseq (+ nobs ncat))) (send self :mouse-mode)))

          (defmeth scatmat :do-brush-click (&rest args)
            (send sp :update-spreadplot 0 4 nil 0)
            (apply #'call-next-method args))
          
          (defmeth scatmat :set-selection-color ()
            (call-next-method)
            (send self :point-color (first (send self :selection)))
            (send sp :update-spreadplot 0 4 (send self :point-state (iseq (+ nobs ncat)))
                  'color (send self :point-color (first (send self :selection)))))
          
          (defmeth scatmat :set-selection-symbol ()
            (call-next-method)
            (send self :point-color (first (send self :selection)))
            (send sp :update-spreadplot 0 4 (send self :point-state (iseq (+ nobs ncat))) 
                  'symbol (send self :point-symbol (first (send self :selection)))))
          
;**spin-plot

          (send spin-plot :scale-type 'fixed)
          (if (> nobs 30)   (send spin-plot  :point-symbol (iseq (+ nobs ncat)) 'dot)                             (send spin-plot  :point-symbol (iseq (+ nobs ncat)) 'disk))
          (send spin-plot :point-symbol (+ nobs (iseq ncat)) 'square)
          (send spin-plot :point-color (iseq (+ nobs ncat)) 'blue)
      (mapcar #'(lambda (a n c) (send spin-plot :point-color (+ nobs(iseq a (+ a n))) c)) a n c)
          (send spin-plot :mouse-mode 'hand-rotate)
          (send spin-plot :scale-constant 1.5 :draw nil)
          (send spin-plot :scale-type 'centroid-fixed)
          (send spin-plot :linked t)
          (send spin-plot :showing-labels t)
          (send spin-plot :menu-template 
                '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH 
                                 SYMBOL COLOR DASH FASTER SLOWER AXES))
          (send spin-plot :new-menu)
          (send spin-plot :add-box)
          (send spin-plot :switch-add-box)
          (setf dimension-lengths 
                (mapcar #'max (abs (send spin-plot :range (iseq ndim)))))
          
          (if (> (send spin-plot :num-variables) 3)
              (send spin-plot :plot-buttons :margin nil :new-z t :box t)
              (send spin-plot :plot-buttons :margin nil :new-x nil 
                    :new-y nil :box t)) 
          
          (defmeth spin-plot :update-plotcell (i j args)
         ;  (send self :start-buffering) removed to avoid a bug PV 3/2002
            (when (and (= i 0) (= j 0))
                  (let* ((cur-var-nums (remove-duplicates (first args)))
                         (cur-var-names (remove-duplicates 
                                         (first (second args))  :test 'equal))
                         (numvars (send self :num-variables))
                         )
                    (when (<= (length cur-var-nums) 2)
                          (setf cur-var-nums 
                                (select 
                                 (combine cur-var-nums 
                                          (set-difference (send self :current-variables)
                                                          cur-var-nums))
                                 (iseq 3)))
                          (setf cur-var-names 
                                (select (send self :variable-labels)
                                        cur-var-nums)))
                    (when (or (= (length cur-var-nums) 3)
                              (and (= (length cur-var-nums) 4)
                                   (= (third (send self :current-variables)) 
                                      (- numvars 1))))
                          (when (= (length cur-var-nums) 4)
                                (setf cur-var-nums (select cur-var-nums '(0 1 2)))
                                (setf cur-var-names 
                                      (select cur-var-names '(0 1 2)))
                                )
                          (apply #'send self  :current-variables cur-var-nums)
                          (send self :set-variables-with-labels cur-var-nums
                                cur-var-names)
                          (send self :transformation nil :draw nil)
                        ;  (send self :add-box)
                          (when (matrixp (send self :slot-value 'rotation-type))
                                (send self :slot-value 'rotation-type 'yawing))
                           ;This adds lines to the plot
                      (let* ((cur-var-nums (remove-duplicates (first args)))
                             (cur-var-names (remove-duplicates 
                                             (first (second args))  :test 'equal))
                             (numvars (send self :num-variables))
                             (mx (select (column-list scores-and-quantification) (min cur-var-nums)))
                             
                             (send self :clear-lines)
                             (MAPCAR '(LAMBDA (START LENGTH color) 
                                        (let* (
                                               (sub-matrix   
                                                (SELECT SCORES-AND-QUANTIFICATION
                                                        (+ nobs (ISEQ START 
                                                                      (+ START (- LENGTH 1))))
                                                            (ISEQ 
                                                             (ARRAY-DIMENSION 
                                                              SCORES-AND-QUANTIFICATION 1))))
                                               )
                                          
                                          (send spin-plot :add-lines
                                                    (COLUMN-LIST 
                                                     (sort-and-permute 
                                                      (select mx  (+ nobs (ISEQ START 
                                                                             (+ START (- LENGTH 1)))))
                                                      sub-matrix ))
                                                :color color)))
                                     a n c)))
                          
                          (send self :redraw)
                        ; (send self :buffer-to-screen)
                          )))
            
            (when (and (= i 1) (= j 1))
                  (send self :point-state (iseq (+ nobs ncat)) (first args)))
            )

          (defmeth spin-plot :adjust-points-in-rect (&rest args)
            (apply #'call-next-method args)
            (send sp :update-spreadplot 
                  0 1 (send self :point-state (iseq (+ nobs ncat))) (send self :mouse-mode))
            )
          
          (defmeth spin-plot :do-brush-click (&rest args)
            (send sp :update-spreadplot 0 1 nil 0)
            (apply #'call-next-method args)
            )

          (defmeth spin-plot :set-selection-color ()
            (call-next-method)
            (send self :point-color (first (send self :selection)))
            (send sp :update-spreadplot 0 1 (send self :point-state (iseq (+ nobs ncat))) 
                  'color
                  (send self :point-color (first (send self :selection)))))
          
          (defmeth spin-plot :set-selection-symbol ()
            (call-next-method)
            (send self :point-color (first (send self :selection)))
            (send sp :update-spreadplot 0 1 (send self :point-state (iseq (+ nobs ncat))) 
                  'symbol
                  (send self :point-symbol (first (send self :selection)))))
          
          (defmeth spin-plot :show-new-var (axis variable)
            (let* ((var-num (position variable (send self :variable-labels)))
                   (cur-vars (send self :current-variables))
                   (cur-var-names nil)
                   (idling (send self :idle-on))
                   )
              (cond
                ((equal (string-downcase axis) "x") 
                 (setf (select cur-vars 0) var-num))
                ((equal (string-downcase axis) "y") 
                 (setf (select cur-vars 1) var-num))
                ((equal (string-downcase axis) "z") 
                 (setf (select cur-vars 2) var-num))
                )
              (setf cur-var-names (select (send self :variable-labels) cur-vars))
              (send self :idle-on nil)
              (send self :transformation nil)
              (apply #'send self :current-variables cur-vars)
              (send self :set-variables-with-labels cur-vars cur-var-names)
              ; (send spin-plot :add-rays rays :ray-labels variable-labels)
              (send self :redraw)
              (send self :idle-on idling)))

         (defmeth spin-plot :plot-help ()
            (plot-help-window (strcat "Help for " (send self :title)))
(paste-plot-help (format nil "Spinning Plot shows object scores (blue dots/disks) and category quantifications (squares in different colors) in 3-dimensional scatterplot. The axes of plot are tripples of HOMALS dimensions.~2%"))
            (show-plot-help)
            (call-next-method :flush nil))

      (MAPCAR '(LAMBDA (START LENGTH color) 
                 (let* (
                       (sub-matrix   (SELECT SCORES-AND-QUANTIFICATION
                                (+ nobs (ISEQ START (+ START (- LENGTH 1))))
                                (ISEQ (ARRAY-DIMENSION SCORES-AND-QUANTIFICATION 1))))
                       (firstcol (coerce (first (column-list sub-matrix)) 'list)))
                   
                 (send spin-plot :add-lines
                       (COLUMN-LIST 
                        (sort-and-permute 
                       firstcol sub-matrix ))
                       :color color))
                 )
              a n c)
      
      )        
          
;**scatterplot 
    (send scatterplot :adjust-scatterplot-to-data 'centroid-fixed)
        (send scatterplot :scale (iseq nvar) 
          (/ (send scatterplot :scale (iseq nvar)) 1.3))
    (send scatterplot :plot-buttons)
    (send scatterplot :point-color (iseq (+ nobs ncat)) 'blue)
    (mapcar #'(lambda (a n c) (send scatterplot :point-color (+ nobs(iseq a (+ a n))) c)) a n c)
    (send scatterplot :use-color t)
    (if (> nobs 30) (send scatterplot :point-symbol (iseq (+ nobs ncat)) 'dot) 
                    (send scatterplot :point-symbol (iseq (+ nobs ncat)) 'disk))
    (send scatterplot :point-symbol (+ nobs (iseq ncat)) 'square)
    (send scatterplot :linked t)
    (send scatterplot :showing-labels t)
    (send scatterplot :mouse-mode 'selecting)
    (send scatterplot :menu-template 
      '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH SYMBOL COLOR ))
    (send scatterplot :new-menu)
    (defmeth scatterplot :adjust-points-in-rect (&rest args)
       (apply #'call-next-method args)
       (send sp :update-spreadplot 
             0 2 (send self :point-state (iseq (+ nobs ncat))) 
             (send self :mouse-mode))
      )

    (defmeth scatterplot :do-brush-click (&rest args)
      (send sp :update-spreadplot 0 2 nil 0)
      (apply #'call-next-method args)
      )

    (defmeth scatterplot :set-selection-color ()
      (call-next-method)
      (send self :point-color (first (send self :selection)))
      (send sp :update-spreadplot 0 2 (send self :point-state (iseq (+ nobs ncat))) 
            'color
             (send self :point-color (first (send self :selection)))))

    (defmeth scatterplot :set-selection-symbol ()
      (call-next-method)
      (send self :point-color (first (send self :selection)))
      (send sp :update-spreadplot 0 2 (send self :point-state (iseq (+ nobs ncat))) 
            'symbol
             (send self :point-symbol (first (send self :selection)))))

    (defmeth scatterplot :redraw-content ()
      (call-next-method)
      (send self :add-grid))

    (defmeth scatterplot :update-plotcell (i j args)
      (when (and (= i 0) (= j 0));when coming from scatmat
            (let* ((cur-var-nums (remove-duplicates (first args))))
              (when (= (length cur-var-nums) 2)
                    (send self :current-variables 
                          (first cur-var-nums)  (second cur-var-nums) 
                          :draw nil)
                    (apply #' send self :y-axis (send self :y-axis))
                    )))
      (when (and (= i 1) (= j 1))
            (send self :point-state (iseq (+ nobs ncat)) (first args)))
      )                          

    (defmeth scatterplot :plot-help ()
            (plot-help-window (strcat "Help for " (send self :title)))
(paste-plot-help (format nil "Scatteplot of object scores (blue disks) and category quantifications (squares in different colors) in pairs of HOMALS dimensions."))
            (show-plot-help)            (call-next-method :flush nil))

    ;**=boxplot2 
    (send boxplot2 :new-menu "BoxPlot" 
              :items '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH  
                            SYMBOL COLOR))
    (send boxplot2 :use-color t)
    (send boxplot2 :SWITCH-BOXES)
    (send boxplot2 :SWITCH-MEAN-LINE)
    (send boxplot2 :range 1 0 1)

(mapcar #'(lambda (v c) (send boxplot2 :point-color (iseq  v v) c)) (iseq (* ndim nvar))  (repeat c ndim))
    (send boxplot2 :point-symbol (iseq (send boxplot2 :num-points)) 'cross)
    (send boxplot2 :linked nil)
    (send boxplot2 :showing-labels t)
    (send boxplot2 :connect-points t)
    (send boxplot2 :mouse-mode 'brushing)

(defmeth boxplot2 :plot-help ()
            (plot-help-window (strcat "Help for " (send self :title)))
(paste-plot-help (format nil "Boxplot of variable discrimination measures in HOMALS dimensions. Averages of those measures appear connected, they represent eigenvalues of HOMALS dimensions and give a measure of the fit of HOMALS solution in each dimension."))
            (show-plot-help)            (call-next-method :flush nil))

;**obs-list 
    (send obs-list :use-color t)
    (send obs-list :point-color (iseq (+ nobs ncat)) 'blue)
    (send obs-list :linked t)
    (mapcar #'(lambda (a n c) (send obs-list :point-color (+ nobs (iseq a (+ a n))) c)) a n c)
    (send obs-list :menu-template '(MOUSE DASH COLOR))
    (send obs-list :new-menu)
    (defmeth obs-list :update-plotcell (i j args)
      (when (and (= i 1) (= j 1))
            (send self :point-state (iseq (+ nobs ncat)) (first args))))

    (defmeth obs-list :adjust-points-in-rect (&rest args)
       (apply #'call-next-method args)
       (send sp :update-spreadplot 
             1 0 (send self :point-state (iseq (+ nobs ncat))) (send self :mouse-mode))
       )

    (defmeth obs-list :do-brush-click (&rest args)
      (send sp :update-spreadplot 1 0 nil 0)
      (apply #'call-next-method args)
      )

    (defmeth obs-list :set-selection-color ()
      (call-next-method)
      (send self :point-color (first (send self :selection)))
      (send sp :update-spreadplot 1 0 (send self :point-state (iseq (+ nobs ncat))) 
            'color
             (send self :point-color (first (send self :selection)))))

    (defmeth obs-list :plot-help ()
            (plot-help-window (strcat "Help for " (send self :title)))
(paste-plot-help (format nil "This window shows object (blue) and category names. Categories of the same variable appear in the same color."))

            (show-plot-help)            (call-next-method :flush nil))

    (send obs-list :fix-name-list)
    (send sp :show-spreadplot)


;;;***OPTIONS***

     (setf Options (send menu-proto :new "Options"))    
    (setf Obj-item (send menu-item-proto :new "Showing Objects"
     :action #'(lambda () 
                 (mapcar #'(lambda (plot)
                             (send plot :point-state 
                                   (iseq nobs (send plot :num-points)) 'invisible)
                             (send plot :point-state 
                                   (iseq nobs ) 'normal)
                             (send plot :redraw)
                             )
                         
                          (if (> ndim 2) (list scatmat spin-plot scatterplot obs-list)
                              (list scatterplot obs-list))
                       ))))
    (setf Cat-item 
      (send menu-item-proto :new "Showing Categories"  
            :action #'(lambda () 

                        (mapcar #'(lambda (plot)
                                    (send plot :point-state 
                                          (iseq nobs ) 'invisible)
                                    (send plot :point-state 
                                          (iseq nobs (send plot :num-points)) 'normal)
                                    (send plot :redraw)
                                    )
                                (if (> ndim 2) (list scatmat spin-plot scatterplot obs-list)
                              (list scatterplot obs-list))
                       ))))
    (setf All-item (send menu-item-proto :new "Showing all"
                      :action #'(lambda ()                                 
                (mapcar #'(lambda 
                            (plot)
                            (send plot :point-state 
                                  (iseq (send plot :num-points)) 'normal)
                        (send plot :redraw)
                            )
                         (if (> ndim 2) (list scatmat spin-plot scatterplot obs-list)
                              (list scatterplot obs-list))
                       ))))

    (send Options :append-items obj-item Cat-item all-item)
    (send Options :install)

(defmeth HOMALS-proto :tplot-item ()
  (let ((lastitem (first (last (send *spreadplot-window-menu* :items))))
        )
    (send *spreadplot-window-menu* :delete-items lastitem)
    (send *spreadplot-window-menu* :delete-items
          (first (last (send *spreadplot-window-menu* :items))))
    (send *spreadplot-window-menu* :append-items

          (send menu-item-proto :new "Transformation Plot"
                :action #'(lambda ()(send self :t-plot)))
          (send dash-item-proto :new)
          lastitem))
  )

    (send self :tplot-item)

(defmeth HOMALS-PROTO :t-plot ()
     
  (setf *spreadplot-container* (make-container 
                                          :free t :local-menus t :type 1 :show nil))
  (let* (
         (plot (boxplot (select (row-list quantification) (iseq  (first a) (- (second a) 1)))
                                 :title "Category Quantification Plot"
                                 :point-labels dim-labels 
                                 :connect-points 
                                 :Y-AXIS-LABEL "Category Quant"
                        :variable-labels (select category-labels (iseq  (first a) (- (second a) 1)))                    
                                 :show nil))

         (variable-list (name-list variable-labels  :title "Categorical Variables" :show nil))
         (dim-list (name-list dim-labels  :title "HOMALS-Dim" :show nil))
         (sp (spread-plot (matrix '(1 3) (list variable-list plot dim-list))    :rel-widths (list .5 2 .5))))

;***dim-list
(send dim-list :use-color t)
(send dim-list :point-color (iseq ndim) 'red)
(send dim-list :linked t)

;***variable-list
(send variable-list :selection '(0))
    (send variable-list :use-color t)
    (mapcar #'(lambda (v c) (send variable-list :point-color (iseq  v v) c)) (iseq (* ndim nvar))  (repeat c ndim))
    (send variable-list :linked nil)

 (defmeth variable-list :do-select-click (&rest args)
     (apply #'call-next-method args)
     (when (send variable-list :selection)
           (let* (
                  (selection (first (send variable-list :selection))))
           (send plot :new-plot (select (row-list quantification) 
                                        (iseq  (select a selection) (- (+ (select a selection) (select n selection)) 1)))
                 :title "Category Quantification Plot"
                 :point-labels dim-labels 
                 :variable-labels (select category-labels (iseq  (select a selection) (- (+ (select a selection) (select n selection)) 1)))
                 :connect-points 
                 :Y-AXIS-LABEL "Category Quant"
                 )                        
             (send plot :point-color (iseq (send plot :num-points)) (send variable-list :point-color selection))
              (send dim-list :point-color (iseq ndim) (send variable-list :point-color selection))
             (send plot :linked t)
                (send plot :redraw)
             )t))
;***plot
    (send plot :showing-labels t)
    (send plot :linked t)
    (send plot :SWITCH-BOXES)
    (send plot :mouse-mode 'brushing)
    (send plot :SWITCH-CONNECT-POINTS)
   (send plot :point-color (iseq (send plot :num-points)) 'red)

                       
  (send sp :show-spreadplot)
    (send *spreadplot-container* :show-window) 
    (refresh-spreadplot)
    (disable-container))

    ))
  )

   
